home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / lib / blt2.4 / tabset.tcl < prev    next >
Encoding:
Text File  |  2009-12-04  |  10.2 KB  |  326 lines
  1. #
  2. # tabset.tcl
  3. #
  4. # ----------------------------------------------------------------------
  5. # Bindings for the BLT tabset widget
  6. # ----------------------------------------------------------------------
  7. #   AUTHOR:  George Howlett
  8. #            Bell Labs Innovations for Lucent Technologies
  9. #            gah@bell-labs.com
  10. #            http://www.tcltk.com/blt
  11. # ----------------------------------------------------------------------
  12. # Copyright (c) 1998  Lucent Technologies, Inc.
  13. # ======================================================================
  14. #
  15. # Permission to use, copy, modify, and distribute this software and its
  16. # documentation for any purpose and without fee is hereby granted,
  17. # provided that the above copyright notice appear in all copies and that
  18. # both that the copyright notice and warranty disclaimer appear in
  19. # supporting documentation, and that the names of Lucent Technologies
  20. # any of their entities not be used in advertising or publicity
  21. # pertaining to distribution of the software without specific, written
  22. # prior permission.
  23. #
  24. # Lucent Technologies disclaims all warranties with regard to this
  25. # software, including all implied warranties of merchantability and
  26. # fitness.  In no event shall Lucent be liable for any special, indirect
  27. # or consequential damages or any damages whatsoever resulting from loss
  28. # of use, data or profits, whether in an action of contract, negligence
  29. # or other tortuous action, arising out of or in connection with the use
  30. # or performance of this software.
  31. #
  32. # ======================================================================
  33.  
  34. #
  35. # Indicates whether to activate (highlight) tabs when the mouse passes
  36. # over them.  This is turned off during scan operations.
  37. #
  38. set bltTabset(activate) yes
  39.  
  40. # ----------------------------------------------------------------------
  41. # 
  42. # ButtonPress assignments
  43. #
  44. #   <ButtonPress-2>    Starts scan mechanism (pushes the tabs)
  45. #   <B2-Motion>        Adjust scan
  46. #   <ButtonRelease-2>    Stops scan
  47. #
  48. # ----------------------------------------------------------------------
  49. bind Tabset <B2-Motion> {
  50.     %W scan dragto %x %y
  51. }
  52.  
  53. bind Tabset <ButtonPress-2> {
  54.     set bltTabset(cursor) [%W cget -cursor]
  55.     set bltTabset(activate) no
  56.     %W configure -cursor hand1
  57.     %W scan mark %x %y
  58. }
  59.  
  60. bind Tabset <ButtonRelease-2> {
  61.     %W configure -cursor $bltTabset(cursor)
  62.     set bltTabset(activate) yes
  63.     %W activate @%x,%y
  64. }
  65.  
  66. # ----------------------------------------------------------------------
  67. # 
  68. # KeyPress assignments
  69. #
  70. #   <KeyPress-Up>    Moves focus to the tab immediately above the 
  71. #            current.
  72. #   <KeyPress-Down>    Moves focus to the tab immediately below the 
  73. #            current.
  74. #   <KeyPress-Left>    Moves focus to the tab immediately left of the 
  75. #            currently focused tab.
  76. #   <KeyPress-Right>    Moves focus to the tab immediately right of the 
  77. #            currently focused tab.
  78. #   <KeyPress-space>    Invokes the commands associated with the current
  79. #            tab.
  80. #   <KeyPress-Return>    Same as above.
  81. #   <KeyPress>        Go to next tab starting with the ASCII character.
  82. #
  83. # ----------------------------------------------------------------------
  84. bind Tabset <KeyPress-Up> { blt::SelectTab %W "up" }
  85. bind Tabset <KeyPress-Down> { blt::SelectTab %W "down" }
  86. bind Tabset <KeyPress-Right> { blt::SelectTab %W "right" }
  87. bind Tabset <KeyPress-Left> { blt::SelectTab %W "left" }
  88. bind Tabset <KeyPress-space> { %W invoke focus }
  89. bind Tabset <KeyPress-Return> { %W invoke focus }
  90.  
  91. bind Tabset <KeyPress> {
  92.     if { [string match {[A-Za-z0-9]*} "%A"] } {
  93.     blt::FindMatchingTab %W %A
  94.     }
  95. }
  96.  
  97. # ----------------------------------------------------------------------
  98. #
  99. # FirstMatchingTab --
  100. #
  101. #    Find the first tab (from the tab that currently has focus) 
  102. #    starting with the same first letter as the tab.  It searches
  103. #    in order of the tab positions and wraps around. If no tab
  104. #    matches, it stops back at the current tab.
  105. #
  106. # Arguments:    
  107. #    widget        Tabset widget.
  108. #    key        ASCII character of key pressed
  109. #
  110. # ----------------------------------------------------------------------
  111. proc blt::FindMatchingTab { widget key } {
  112.     set key [string tolower $key]
  113.     set itab [$widget index focus]
  114.     set numTabs [$widget size]
  115.     for { set i 0 } { $i < $numTabs } { incr i } {
  116.     if { [incr itab] >= $numTabs } {
  117.         set itab 0
  118.     }
  119.     set name [$widget get $itab]
  120.     set label [string tolower [$widget tab cget $name -text]]
  121.     if { [string index $label 0] == $key } {
  122.         break
  123.     }
  124.     }
  125.     $widget focus $itab
  126.     $widget see focus
  127. }
  128.  
  129. # ----------------------------------------------------------------------
  130. #
  131. # SelectTab --
  132. #
  133. #    Invokes the command for the tab.  If the widget associated tab 
  134. #    is currently torn off, the tearoff is raised.
  135. #
  136. # Arguments:    
  137. #    widget        Tabset widget.
  138. #    x y        Unused.
  139. #
  140. # ----------------------------------------------------------------------
  141. proc blt::SelectTab { widget tab } {
  142.     set index [$widget index $tab]
  143.     if { $index != "" } {
  144.     $widget select $index
  145.     $widget focus $index
  146.     $widget see $index
  147.     set w [$widget tab tearoff $index]
  148.     if { ($w != "") && ($w != "$widget") } {
  149.         raise [winfo toplevel $w]
  150.     }
  151.     $widget invoke $index
  152.     }
  153. }
  154.  
  155. # ----------------------------------------------------------------------
  156. #
  157. # DestroyTearoff --
  158. #
  159. #    Destroys the toplevel window and the container tearoff 
  160. #    window holding the embedded widget.  The widget is placed
  161. #    back inside the tab.
  162. #
  163. # Arguments:    
  164. #    widget        Tabset widget.
  165. #    tab        Tab selected.
  166. #
  167. # ----------------------------------------------------------------------
  168. proc blt::DestroyTearoff { widget tab } {
  169.     regsub -all {\.} [$widget get $tab] {_} name
  170.     set top "$widget.toplevel-$name"
  171.     if { [winfo exists $top] } {
  172.     wm withdraw $top
  173.     update
  174.     $widget tab tearoff $tab $widget
  175.     destroy $top
  176.     }
  177. }
  178.  
  179. # ----------------------------------------------------------------------
  180. #
  181. # CreateTearoff --
  182. #
  183. #    Creates a new toplevel window and moves the embedded widget
  184. #    into it.  The toplevel is placed just below the tab.  The
  185. #    DELETE WINDOW property is set so that if the toplevel window 
  186. #    is requested to be deleted by the window manager, the embedded
  187. #    widget is placed back inside of the tab.  Note also that 
  188. #    if the tabset container is ever destroyed, the toplevel is
  189. #    also destroyed.  
  190. #
  191. # Arguments:    
  192. #    widget        Tabset widget.
  193. #    tab        Tab selected.
  194. #    x y        The coordinates of the mouse pointer.
  195. #
  196. # ----------------------------------------------------------------------
  197. proc blt::CreateTearoff { widget tab rootX rootY } {
  198.  
  199.     # ------------------------------------------------------------------
  200.     # When reparenting the window contained in the tab, check if the
  201.     # window or any window in its hierarchy currently has focus.
  202.     # Since we're reparenting windows behind its back, Tk can
  203.     # mistakenly activate the keyboard focus when the mouse enters the
  204.     # old toplevel.  The simplest way to deal with this problem is to
  205.     # take the focus off the window and set it to the tabset widget
  206.     # itself.
  207.     # ------------------------------------------------------------------
  208.  
  209.     set focus [focus]
  210.     set name [$widget get $tab]
  211.     set window [$widget tab cget $name -window]
  212.     if { ($focus == $window) || ([string match  $window.* $focus]) } {
  213.     focus -force $widget
  214.     }
  215.     regsub -all {\.} [$widget get $tab] {_} name
  216.     set top "$widget.toplevel-$name"
  217.     toplevel $top
  218.     $widget tab tearoff $tab $top.container
  219.     table $top $top.container -fill both
  220.  
  221.     incr rootX 10 ; incr rootY 10
  222.     wm geometry $top +$rootX+$rootY
  223.     set name [$widget get $tab]
  224.  
  225.     set parent [winfo toplevel $widget]
  226.     wm title $top "[wm title $parent]: [$widget tab cget $name -text]"
  227.     wm transient $top $parent
  228.  
  229.     #blt::winop changes $top
  230.  
  231.     # 
  232.     # If the user tries to delete the toplevel, put the window back
  233.     # into the tab folder.  
  234.     #
  235.     wm protocol $top WM_DELETE_WINDOW [list blt::DestroyTearoff $widget $tab]
  236.     # 
  237.     # If the container is ever destroyed, automatically destroy the
  238.     # toplevel too.  
  239.     #
  240.     bind $top.container <Destroy> [list destroy $top]
  241. }
  242.  
  243. # ----------------------------------------------------------------------
  244. #
  245. # Tearoff --
  246. #
  247. #    Toggles the tab tearoff.  If the tab contains a embedded widget, 
  248. #    it is placed inside of a toplevel window.  If the widget has 
  249. #    already been torn off, the widget is replaced back in the tab.
  250. #
  251. # Arguments:    
  252. #    widget        tabset widget.
  253. #    x y        The coordinates of the mouse pointer.
  254. #
  255. # ----------------------------------------------------------------------
  256. proc blt::Tearoff { widget x y index } {
  257.     set tab [$widget index -index $index]
  258.     if { $tab == "" } {
  259.     return
  260.     }
  261.     $widget invoke $tab
  262.  
  263.     set container [$widget tab tearoff $index]
  264.     if { $container == "$widget" } {
  265.     blt::CreateTearoff $widget $tab $x $y
  266.     } elseif { $container != "" } {
  267.     blt::DestroyTearoff $widget $tab
  268.     }
  269. }
  270.  
  271. # ----------------------------------------------------------------------
  272. #
  273. # TabsetInit
  274. #
  275. #    Invoked from C whenever a new tabset widget is created.
  276. #    Sets up the default bindings for the all tab entries.  
  277. #    These bindings are local to the widget, so they can't be 
  278. #    set through the usual widget class bind tags mechanism.
  279. #
  280. #    <Enter>        Activates the tab.
  281. #    <Leave>        Deactivates all tabs.
  282. #    <ButtonPress-1>    Selects the tab and invokes its command.
  283. #    <Control-ButtonPress-1>    
  284. #            Toggles the tab tearoff.  If the tab contains
  285. #            a embedded widget, it is placed inside of a
  286. #            toplevel window.  If the widget has already
  287. #            been torn off, the widget is replaced back
  288. #            in the tab.
  289. #
  290. # Arguments:    
  291. #    widget        tabset widget
  292. #
  293. # ----------------------------------------------------------------------
  294. proc blt::TabsetInit { widget } {
  295.     $widget bind all <Enter> { 
  296.     if { $bltTabset(activate) } {
  297.         %W activate current
  298.         }
  299.     }
  300.     $widget bind all <Leave> { 
  301.         %W activate "" 
  302.     }
  303.     $widget bind all <ButtonPress-1> { 
  304.     blt::SelectTab %W "current"
  305.     }
  306.     $widget bind all <Control-ButtonPress-1> { 
  307.     if { [%W cget -tearoff] } {
  308.         blt::Tearoff %W %X %Y active
  309.     }
  310.     }
  311.     $widget configure -perforationcommand {
  312.     blt::Tearoff %W $bltTabset(x) $bltTabset(y) select
  313.     }
  314.     $widget bind Perforation <Enter> { 
  315.     %W perforation activate on
  316.     }
  317.     $widget bind Perforation <Leave> { 
  318.     %W perforation activate off
  319.     }
  320.     $widget bind Perforation <ButtonPress-1> { 
  321.     set bltTabset(x) %X
  322.     set bltTabset(y) %Y
  323.     %W perforation invoke
  324.     }
  325. }
  326.